home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / iqb9104.zip / LIST.BAS < prev    next >
BASIC Source File  |  1991-03-20  |  6KB  |  220 lines
  1. ' LIST.BAS, demonstrates using a random disk file 
  2. ' to maintain a linked list.
  3.  
  4. DECLARE SUB Delete ()
  5. DECLARE SUB DisplayData ()
  6. DECLARE FUNCTION Menu$ ()
  7. DECLARE SUB EnterData ()
  8. DECLARE SUB InsertRecord ()
  9.  
  10. ON ERROR GOTO ErrorHandler
  11. DEFINT A-Z
  12.  
  13. TYPE PartRecord
  14.     Named AS STRING * 16
  15.     Number AS STRING * 10
  16.     NextPart AS INTEGER
  17. END TYPE
  18.  
  19. DIM SHARED Part AS PartRecord
  20. DIM SHARED OldPart1 AS PartRecord
  21. DIM SHARED OldPart2 AS PartRecord
  22.  
  23. ' Try to open header file. If file not found,
  24. ' we must be starting a new list, and the 
  25. ' error routine sets FirstRecord to 1.
  26.  
  27. 100 OPEN "partlist.hdr" FOR INPUT AS #1
  28.     INPUT #1, FirstRecord, NumberOfRecords
  29.     CLOSE #1
  30.  
  31. 200  ' Open data file, point NextRecord to 
  32.      ' the end of the file.
  33.  
  34. OPEN "partlist.dat" FOR RANDOM AS #1 _
  35.      LEN = LEN(Part)
  36. NextRecord = LOF(1) \ LEN(Part) + 1
  37. CLS
  38. DO
  39.   SELECT CASE Menu$
  40.     CASE "E"
  41.         CALL EnterData
  42.     CASE "X"
  43.         ' Write value of FirstRecord to file
  44.         OPEN "partlist.hdr" FOR OUTPUT AS #2
  45.         WRITE #2, FirstRecord, NumberOfRecords
  46.         CLOSE : CLS : END
  47.     CASE "P"
  48.         CALL DisplayData
  49.     CASE "D"
  50.         CALL Delete
  51.   END SELECT
  52. LOOP
  53. END     ' end of LIST.BAS
  54.  
  55. ErrorHandler:
  56.     IF ERR = 53 AND ERL = 100 THEN
  57.       FirstRecord = 1: RESUME 200
  58.     END IF
  59.  
  60.     PRINT "Error"; ERR
  61.     PRINT "Hit any key to exit program."
  62.     WHILE INKEY$ = "": WEND
  63.     END
  64.  
  65. ' ***********************************************
  66. SUB Delete
  67. ' Delete an element from the linked list.
  68. SHARED NextRecord, FirstRecord, NumberOfRecords
  69. DIM Target AS STRING * 16
  70. NumDeleted = 0
  71. CLS
  72. INPUT "Enter name of part to delete:"; Target
  73. PRINT
  74. j = FirstRecord
  75. DO
  76.     GET #1, j, part
  77.     IF Part.Named = Target THEN
  78.         Part.Named = "????????????????"
  79.         NextOne = Part.NextPart
  80.         NumDeleted = 1
  81.         NumberOfRecords = NumberOfRecords - 1
  82.         IF j = FirstRecord THEN
  83.             FirstRecord = Part.NextPart
  84.             PUT #1, j, Part
  85.         ELSE
  86.             PUT #1, j, Part
  87.             GET #1, LastRecord, Part
  88.             Part.NextPart = NextOne
  89.             PUT #1, LastRecord, Part
  90.         END IF
  91.         EXIT DO
  92.     ELSE
  93.         LastRecord = j
  94.         j = Part.NextPart
  95.         IF j = 0 THEN EXIT DO
  96.     END IF
  97. LOOP
  98. IF NumDeleted = 0 THEN
  99.     PRINT "Not found"
  100. ELSE
  101.     PRINT "Found and deleted."
  102. END IF
  103. PRINT : PRINT "Press any key"
  104. WHILE INKEY$ = "": WEND
  105. END SUB          ' end of delete
  106. ' ***********************************************
  107. SUB DisplayData
  108. ' Displays the list elements on the screen.
  109. SHARED NextRecord, FirstRecord, NumberOfRecords
  110. CLS
  111. j = FirstRecord
  112. FOR i = 1 TO NumberOfRecords
  113.     GET #1, j, part
  114.     PRINT "Record #"; i; ": ";
  115.     PRINT Part.Named, Part.Number
  116.     j = Part.NextPart
  117. NEXT i
  118. WHILE INKEY$ = ""
  119. WEND
  120. END SUB     ' end of DisplayData
  121. ' ***********************************************
  122. SUB EnterData
  123. ' Enter a new record into the linked list.
  124. SHARED NumberOfRecords
  125. CLS
  126. DO
  127.   INPUT "Enter part name (blank to exit): ", Temp$
  128.   IF Temp$ = "" THEN
  129.     EXIT DO
  130.   ELSE
  131.     Part.Named = Temp$
  132.   END IF
  133.   INPUT "Enter part number: ", Part.Number
  134.   NumberOfRecords = NumberOfRecords + 1
  135.   ' If NextRecord = 1 we are starting a new
  136.   ' data file. Otherwise we must inset the new 
  137.   ' record into its proper position in the
  138.   ' existing list.
  139.   IF NextRecord = 1 THEN
  140.     part.NextPart = 0
  141.     PUT #1, NextRecord, part
  142.     NextRecord = NextRecord + 1
  143.   ELSE
  144.     CALL InsertRecord
  145.   END IF
  146. LOOP
  147. END SUB
  148. ' ***********************************************
  149. SUB InsertRecord
  150. ' Inserts a new record into its proper position
  151. ' in random file linked list.
  152. SHARED NextRecord, FirstRecord, NumberOfRecords
  153. i = FirstRecord
  154. DO
  155.   ' Retrieve the first record in the list.
  156.   GET #1, i, OldPart2
  157.   ' Should the new entry come before it?
  158.   IF UCASE$(Part.Named) < UCASE$(OldPart2.Named) _
  159.   THEN
  160.     ' If i = FirstRecord then the new record will
  161.     ' become the first one in the list.
  162.     IF i = FirstRecord THEN
  163.       Part.NextPart = FirstRecord
  164.       FirstRecord = NextRecord
  165.       PUT #1, NextRecord, Part
  166.       NextRecord = NextRecord + 1
  167.       EXIT DO
  168.       ' If i <> FirstRecord, we must put the new
  169.       ' record between two existing records.
  170.     ELSE
  171.        Part.NextPart = OldPart1.NextPart
  172.        OldPart1.NextPart = NextRecord
  173.        PUT #1, LastRecord, OldPart1
  174.        PUT #1, NextRecord, Part
  175.        NextRecord = NextRecord + 1
  176.        EXIT DO
  177.     END IF
  178.   ELSE
  179.     ' If we haven't reached the end of the file,
  180.     ' save the current record then loop back
  181.     ' to get the next one.
  182.     IF OldPart2.NextPart > 0 THEN
  183.       LastRecord = i
  184.       i = OldPart2.NextPart
  185.       OldPart1 = OldPart2
  186.       ' If we have reached the end of the file,
  187.       ' the new record must be "larger" than all
  188.       ' existing records and should therefore
  189.       ' become the last record in the list.
  190.     ELSE
  191.       OldPart2.NextPart = NextRecord
  192.       PUT #1, i, OldPart2
  193.       Part.NextPart = 0
  194.       PUT #1, NextRecord, Part
  195.       NextRecord = NextRecord + 1
  196.       EXIT DO
  197.     END IF
  198.   END IF
  199. LOOP
  200. END SUB     'end of InsertRecord
  201. ' ***********************************************
  202. FUNCTION Menu$
  203. ' Displays a Menu and returns the key pressed.
  204. CLS
  205. LOCATE 5, 10
  206. PRINT "Linked list demonstration program"
  207. LOCATE 6, 10
  208. PRINT "------------------------------------"
  209. LOCATE 7, 12
  210. PRINT "E -> Enter new data"
  211. LOCATE 8, 12
  212. PRINT "D -> Delete old data"
  213. LOCATE 9, 12
  214. PRINT "P -> Print data on screen"
  215. LOCATE 11, 12
  216. PRINT "X -> Exit program"
  217. DO: k$ = INKEY$: LOOP UNTIL k$ <> ""
  218. Menu$ = UCASE$(k$)
  219. END FUNCTION
  220.